home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ShareWare OnLine 2
/
ShareWare OnLine Volume 2 (CMS Software)(1993).iso
/
prog
/
bcc101.zip
/
PBCODE.ZIP
/
NET001.BAS
Wrap
BASIC Source File
|
1993-03-19
|
12KB
|
319 lines
' This FILE: "NET001.BAS" is placed in the public domain by the author:
' Lewis Balentine, 19 March 1993. The author specificly denies all warranties,
' exspressed or implied, of fittness or function.
' ->>>> use or abuse as you see fit <<<<-
'----------------------------------------------------------------------------
' The code in this file is intended to be compiled with Spectra Publishing's
' Power Basic version 3.0. It provides functions that interface the Novell
' Netware connection API. Sample program code prints this information to
' the screen. (FYI: TABS set to 4)
'
' Functions included are:
' GetConnectNummber% -> Netware Logical Connection number
' GetConnectInfo% -> Information logged in user
' GetNode$ -> Stations physical node
'
'----------------------------------------------------------------------------
'PGN PAGE: XXX in this program remarks refers to a page in the book:
' "Programers Guide to Netware", Charles G. Rose, (c) 1990 McGraw Hill.
'============================================================================
$compile exe
$debug map on
$dim array
DECLARE FUNCTION GetStrLoc&(byval AllocHandle%) ' so ASM CALL can find it
'----------------------------------------------------------------------------
' Constants for use with PB3's REGS function/statement.
%FLAGS = 0
%AX = 1
%BX = 2
%CX = 3
%DX = 4
%SI = 5
%DI = 6
%BP = 7
%DS = 8
%ES = 9
'----------------------------------------------------------------------------
type ConInfoReq ' Connection Information Request Buffer
length as word ' (LoHi) Request buffer length (4 - 2 = 2)
cll as byte ' Set to &H16
con as byte ' logical connection number
end type
type ConInfoRep ' Connection Information Reply Buffer
length as word ' (LoHi) Reply buffer length (64 - 2 = 62)
id as Dword ' (HiLo) Object ID
tipe as word ' (HiLo) Object Type
nam as string * 48 ' Object Name
Yr as Byte ' Log in Year where 0 = 1980
Mo as Byte ' Month (1 to 12)
Dy as Byte ' Day (1 to 31)
Hr as Byte ' Hour (0 to 23)
Mn as Byte ' Minute (0 to 59)
Sc as Byte ' Second (0 to 59)
Wk as Byte ' WeekDay where 0=Sunday
Extra as Byte ' Undefined extra byte
end type
'----------------------------------------------------------------------------
' the FourByte, TwoByte types and HiLoWord, HiLoDWord are used in the functions
' SwapBytesW and SwapBytesDW.
Type FourByte
B1 as Byte
B2 as Byte
B3 as Byte
B4 as Byte
end Type
Type TwoByte
B1 as Byte
B2 as Byte
end Type
Union HiLoWord
Wrd as Word
BB as TwoByte
end Union
Union HiLoDWord
DW as Dword
BB as FourByte
end Union
'============================================================================
' This is the "MAIN" code of the prgram. It prints Netware Connection
' Information about the workstation and logged on user.
'============================================================================
start:
dim info as ConInfoRep
connect%=GetConnectNumber%
print
if connect%=0 then
print "This workstation is not logged in to the network."
end
end if
errr%=GetConnectInfo%(connect%,info)
if errr%<>0 then
print "Get Netware Connection Information failed."
end
else
Print "Logical Connection number is (DEC): ";connect%
Print " LogIn Name is: "; trim$(info.nam)
print " Netware Object ID is (HEX): "; DWHex$(SwapBytesDW???(info.id))
print " Netware Object Type is (HEX): ";Right$(DWHex$(SwapBytesW??(info.tipe)),4)
print " WorkStation Node is (HEX): "; getnode$
end if
end
'=============================================================================
' Below are the function used by the program.
'=============================================================================
' function to return Netware Logical Connection number
function GetConnectNumber% ' PGN PAGE: 274
' if 0 then not logged in
local c%
!xor AX,AX ' zero AX
!mov AH,&Hdc ' Netware API call for Connect #
!int &H21 ' Call Netware (returns AX=&Hdc32)
!xor AH,AH ' Mask off the high byte
!mov c%,AX ' AL contains connection number
GetConnectNumber%= c%
end function
'----------------------------------------------------------------------------
' function to return info about the Netware object at a specific connection #
' PGN PAGE: 272
function GetConnectInfo% (con%, reply as coninforep) Local
dim request as ConInfoReq
request.length=2
request.cll=&H16
request.con=con%
reply.length=62
reg %ES, varseg(reply)
reg %DI, varptr(reply)
reg %DS, varseg(request)
reg %SI, varptr(request)
reg %AX, &HE300
call interrupt &H21
reply.Extra = Reg(%AX) and &H00FF ' 0 indicates succesful call
GetConnectInfo%=reply.extra
end function
'----------------------------------------------------------------------------
' funtion to return 6 byte Physical Node Address of the requesting workstation
' PowerBasic does not have a 6 byte integer type so we are going to return
' a 12 byte string representation of the unsigned Hexidecimal number.
' There is probably a better way to do this, but ....
function GetNode$ ' PGN PAGE: 276
temp$="000000000000" ' 6 bytes requires 12 characters
! push DI ; save Destination Index
!
! mov AX,&Hee00
! int &H21 ; Call Netware
!
' ! mov AX,&h4321 ; for test of conversion
' ! mov BX,&h8765 ; for test of conversion
' ! mov CX,&hCBA9 ; for test of conversion
!
! push CX ; Node returned in CX,BX,AX
! push BX
! push AX
' setup our working string
! mov AX,temp$ ' string handle
! push AX ' now for location and length
! call getstrloc ' return: location=DX:AX, length=CX
! dec CX ' reduce count by one
! add AX, CX ' we need the end of the string
! mov ES, DX ' store our address of string
! mov DI, AX ' in ES:DI
! std ; set direction flag for decriment
! mov CX,&h0003
GetNodeLoop:
! pop BX ; get word from stack
! mov AH,4 ; (4 nibbles)
! call WHex ; translate
! loop GetNodeLoop
! pop DI ; restore resisters
! cld
GetNode$=temp$
end function
'----------------------------------------------------------------------------
' functions to swap High and Low bytes of a Word/DWord
' Netware was origionally only available on a Motorola 6800 server. Motorola
' stores numbers with the most significant byte first. Intel stores numbers
' with the least significant byte first. This function is use to translate
' the old style unsigned wird values. Note that it does not change the input.
function SwapBytesW?? (wrd??) Local
dim temp as HiLoWord
temp.Wrd=wrd??
swap temp.bb.b1 , temp.bb.b2
SwapBytesW??=temp.Wrd
end function
'----------------------------------------------------------------------------
function SwapBytesDW??? (DW???) Local
dim temp as HiLoDWord
temp.DW=DW???
'print hex$(temp.bb.b1), hex$(temp.bb.b4)
swap temp.bb.b1, temp.bb.b4
swap temp.bb.b2, temp.bb.b3
SwapBytesDW???=temp.DW
end function
'----------------------------------------------------------------------------
' function to return the value of the string representation of Hexidecimal
' number. PB's "&Hxxxx" is limited to compile time and/or two bytes.
' NOTE: This function assumes unsigned strings !
' NOTE: This function ignores the invalid characters!
function DWHexVal???( DW as string) Local
dim temp as string
temp=ucase$(DW)
while len(temp)>0
p= instr("0123456789ABCDEF",left$(temp$,1))
if p>0 then
shift left t???,4
t???=t???+(p-1)
end if
' print p,t???,temp
temp=mid$(temp,2)
wend
DWHexVal???=t???
end function
'----------------------------------------------------------------------------
' function to return a 8 character Hexidecimal string representation of
' a four byte DoubleWord variable. (PB's HEX$ function is limited to 2 Bytes)
function DWHex$ (DW as DWord) Local
temp$="87654321" ' allocate 8 byte character string
' PAGE: 333 of PB3 Programers Guide
' " ... save the SI,DI,BP,DS,SS and SP registers."
' of these we only modify the DI register.
! push DI ; save Destination Index
' setup our working string
! mov AX,temp$ ' string handle
! push AX ' now for location and length
! call getstrloc ' return: location=DX:AX, length=CX
! dec CX ' reduce count by one
! add AX, CX ' we need the end of the string
' setup our DoubleWord Variable
! les di,[bp+6] ' get the address from the stack
! mov BX, es:[di] ' store lo word
! inc di ' move index foward
! inc di ' two bytes
! mov CX, es:[di] ' store hi word
! mov ES, DX ' store our address in of string
! mov DI, AX ' in ES:DI
! std ' set the direction flag
! mov AH,4 ' 1 word = 4 nibbles
! call Whex ' now convert
! mov BX,CX ' get the hi word
! mov AH,4 ' 1 word = 4 nibbles
! call WHex ' convert it
! pop DI ' restore Destination Index
' PAGE: 333 of PB3 Programers Guide
' " ... all these calls also require you clear ... the processor
' direction flag before returning to caller. ..."
! cld
DWHex$=temp$
end function
'----------------------------------------------------------------------------
' This function trims the "white space" from both ends of string.
' It also removes ANY contol characters (0 to 31).
function trim$(t$)
dim temp as string
for i=1 to len(t$)
tt$=mid$(t$,i,1)
if tt$=>" " then temp=temp+tt$
next i
trim$=ltrim$(rtrim$(temp))
end function
'=============================================================================
' below are misc ASSEMBLY soubroutines called from the inline ASM functions
'=============================================================================
' Most, if not all, of this assembly work could have been done in pure Basic.
' The main reason I did it in assembly was to get some idea of what could
' be done (and how) with the INLINE ASM capability of PB3.
' Having gone to the trouble ..... I am going to use it.
'-----------------------------------------------------------------------------
! ; ASM routine converts the WORD in BX to a Hex String representation
! ; on entry
! ; ES:DI = pointer to end of string (works right to left)
! ; BX = value to be converted
! ; AH = number of nibbles (hex digits) to convert (0 to 4)
! ; direction flag = set (decrement)
! ; on exit
! ; BX = undefined (contents rotated, 4 digits->BXin=BXout)
! ; AH = zero
! ; AL = last Hex Character
! ; AX = undefined (AH =0, AL last Hex digit)
! ; ES:DI = byte in front of hex string
! ; The only other register affected is the flag register.
! ; NOTES:
! ; NO ERROR CHECKING, THIS WILL WRITE OVER ANYTHING (or at least try)!!
! ; THIS ROUTINE USES A NEAR RETURN, MUST CALL FROM SAME CODE SEG !!!!
WHex:
! cmp AH,0 ; if 0 then
! jz WHexExit ; out of here
! mov AL, BL ; get value from BX
! and AL, &h0F ; mask off low nibble
! dec AH ; sub one from our counter
! ror BX, 1 ; rotate the next nibble in BX
! ror BX, 1 ; four rotates are used so that
! ror BX, 1 ; this will work on an 8088
! ror BX, 1 ; rotate is used to preserve BX
! cmp AL, &H0009 ; if greater than 9 then
! jg WHexAlpha ; jump to alpha character
! add AL, &h30 ; else add offset for numeric
! stosb ; store val in AL at ES:DI, DI=DI-1
! jmp WHex ; do it again Sam ...
WHexAlpha:
! add AL, &h37 ; add offset for alpha character
! stosb ; store val in AL at ES:DI, DI=DI-1
! jmp WHex ; do it again Sam ...
WHexExit:
! retn ; back to whince we came (I hope)
'-----------------------------------------------------------------------------
' more to come, maybe ....
' End of File <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
